home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / INTERCOM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-28  |  11KB  |  295 lines
  1. UNIT InterCom;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Intercommunication routies                    Last changed: 28.04.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-96 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, PopTypes;
  16.  
  17. FUNCTION  OpenInterCom(TaskNum: Byte; CONST Address: TFidoAddress): Boolean;
  18. PROCEDURE CloseInterCom;
  19. FUNCTION  SetInterCom(Status: Byte; CONST InAdr: TFidoAddress; Ask: Boolean): Boolean;
  20. FUNCTION  GetInterCom(TaskNum: Byte; Var ICR: TInterCom): Boolean;
  21. FUNCTION  GetMaxLines: Byte;
  22. FUNCTION  ICStatusStr(CONST ICR: TInterCom): String;
  23. PROCEDURE SetToDoFlags(Flag: Word);
  24. FUNCTION  CheckICToDo(Flag: Word): Boolean;
  25.  
  26. IMPLEMENTATION
  27.  
  28. USES Dos, OpString,
  29.      Globals, NetFile, LogFile, StrUtil, MTask, MailUtil;
  30.  
  31. CONST
  32.   InterComFile: PNetFile = NIL;
  33.  
  34. VAR
  35.   ICTaskNum   : Byte;
  36.  
  37.   FUNCTION GetMaxLines: Byte;
  38.   BEGIN
  39.     GetMaxLines:=InterComFile^.FileSize;
  40.   END;
  41.  
  42.   FUNCTION GetInterCom(TaskNum: Byte; Var ICR: TInterCom): Boolean;
  43.   BEGIN
  44.     InterComFile^.GetRec(ICR, TaskNum, NoKeep, Wait);
  45.     GetInterCom:=(InterComFile^.IoResult=0);
  46.   END;
  47.  
  48.   FUNCTION CheckICToDo(Flag: Word): Boolean;
  49.   VAR
  50.     IC:TInterCom;
  51.   BEGIN
  52.     REPEAT
  53.       GiveUpTime;
  54.     UNTIL GetInterCom(ICTaskNum,IC);
  55.     CheckICToDo:=(IC.ToDoFlags AND Flag)<>0;
  56.     IC.ToDoFlags:=IC.ToDoFlags AND (NOT Flag);
  57.     InterComFile^.PutRec(IC,ICTaskNum);
  58.   END;
  59.  
  60.   FUNCTION SetInterCom(Status: Byte; CONST InAdr: TFidoAddress; Ask: Boolean): Boolean;
  61.   VAR
  62.     i, Tries : Byte;
  63.     GotIt    : Boolean;
  64.     TmpICRec : TInterCom;
  65.     HaveConflict: Boolean;
  66.     InterComRec : TInterCom;
  67.  
  68.     FUNCTION Informal(Status: Byte): Boolean;
  69.     BEGIN
  70.       Informal:=(Status<$80);
  71.     END;
  72.  
  73.     FUNCTION Conflict(CONST TmpICRec,InterComRec: TInterCom; Ask: Boolean): Boolean ;
  74.     VAR
  75.       s: String ;
  76.     BEGIN
  77.       Conflict:=False ;
  78.       s:=' line '+Long2Str(i);
  79.       CASE TmpICRec.Status OF
  80.         ICPolling    : IF CmpAdr(TmpICRec.PollAddress,InterComRec.PollAddress) THEN
  81.                        BEGIN
  82.                          CASE InterComRec.Status OF
  83.                            ICPolling : BEGIN
  84.                                          Conflict:=True ;
  85.                                          AddLog(':','Node is being polled by'+s) ;
  86.                                        END ;
  87.                            ICConnect : BEGIN
  88.                                          Conflict:=True ;
  89.                                          AddLog(':','Node is connected to'+s) ;
  90.                                        END ;
  91.                          END ;
  92.                        END;
  93.         ICFileFwd    : CASE InterComRec.Status OF
  94.                          ICFileFwd : BEGIN
  95.                                        Conflict:=True ;
  96.                                        AddLog(':','Files are being forwarded on'+s) ;
  97.                                      END ;
  98.                        END;
  99.         ICConnect    : IF CmpAdr(TmpICRec.PollAddress,InterComRec.PollAddress) THEN
  100.                        BEGIN
  101.                          CASE InterComRec.Status OF
  102.                            ICPolling : BEGIN
  103.                                          Conflict:=True ;
  104.                                          AddLog(':','Node is connected to'+s) ;
  105.                                        END ;
  106.                            ICConnect : BEGIN
  107.                                          Conflict:=True ;
  108.                                          AddLog(':','Node is connected to'+s+' ????') ;
  109.                                        END ;
  110.                          END ;
  111.                        END;
  112.  
  113.         ICNLComp     : CASE InterComRec.Status OF
  114.                          ICNLComp  : BEGIN
  115.                                        Conflict:=True ;
  116.                                        AddLog(':','Nodelist is being compiled by'+s) ;
  117.                                      END ;
  118.                          ICNLMan   : BEGIN
  119.                                        Conflict:=True ;
  120.                                        AddLog(':','Nodelist manager is in use on'+s) ;
  121.                                      END ;
  122.                        END;
  123.         ICUnpackMail : CASE InterComRec.Status OF
  124.                          ICUnpackMail : BEGIN
  125.                                           Conflict:=True ;
  126.   {                                       InterComRec.ToDoFlags:=ICTDUnpackMail;}
  127.                                           AddLog(':','Mail is being unpacked by'+s) ;
  128.                                         END ;
  129.                        END;
  130.         ICOutMan     : CASE InterComRec.Status OF
  131.                          ICOutMan : BEGIN
  132.                                       Conflict:=True ;
  133.                                       AddLog(':','Outman is in use on'+s) ;
  134.                                     END ;
  135.                        END;
  136.         ICNLMan      : CASE InterComRec.Status OF
  137.                          ICNLComp  : BEGIN
  138.                                        Conflict:=True ;
  139.                                        AddLog(':','Nodelist is being compiled by'+s) ;
  140.                                      END ;
  141.                          ICNLMan   : BEGIN
  142.                                        Conflict:=True ;
  143.                                        AddLog(':','Nodelist manager is in use on'+s) ;
  144.                                      END ;
  145.                        END;
  146.         ICUserEd     : CASE InterComRec.Status OF
  147.                          ICUserEd : BEGIN
  148.                                       Conflict:=True;
  149.                                       AddLog(':','Usereditor in use on'+s)
  150.                                     END;
  151.                        END;
  152.         ICScanNetMail: CASE InterComRec.Status OF
  153.                          ICScanNetMail : BEGIN
  154.                                       Conflict:=True;
  155.                                       AddLog(':','Netmail is being scanned on'+s)
  156.                                     END;
  157.                        END;
  158.         ICTick       : CASE InterComRec.Status OF
  159.                          ICTick : BEGIN
  160.                                     Conflict:=True;
  161.                                     AddLog(':','Tick''s are being processed on'+s)
  162.                                   END;
  163.                        END;
  164.       END ;
  165.     END ;
  166.  
  167.   BEGIN
  168.     SetInterCom:=False;
  169.     OpenLockFile;
  170.     Tries:=0;
  171.     REPEAT
  172.       GotIt:=NetGrabFile(NetICFile);
  173.       Inc(Tries);
  174.     UNTIL GotIt OR (Tries=5);
  175.     IF GotIt THEN
  176.     BEGIN
  177.       InterComFile^.GetRec(InterComRec, ICTaskNum, Keep, Wait);
  178.       InterComRec.Status:=Status;
  179.       InterComRec.PollAddress:=InAdr;
  180.       HaveConflict:=False;
  181.       IF Not Informal(Status) THEN
  182.       BEGIN
  183.         i:=0 ;
  184.         REPEAT
  185.           IF i<>IcTaskNum THEN
  186.           BEGIN
  187.             InterComFile^.GetRec(TmpICRec, i, NoKeep, Wait);
  188.             IF Conflict(TmpICRec,InterComRec,Ask) THEN HaveConflict:=True;
  189.           END;
  190.           Inc(i) ;
  191.         UNTIL (i>=GetMaxLines) OR (HaveConflict);
  192.       END;
  193.       IF Not HaveConflict THEN
  194.       BEGIN
  195.         SetInterCom:=True;
  196.       END ELSE
  197.       BEGIN
  198.         InterComRec.Status:=ICIdle;
  199.       END;
  200.       InterComFile^.PutRec(InterComRec, ICTaskNum);
  201.       NetReleaseFile(NetICFile);
  202.     END ELSE
  203.       AddLog('!','Can not access the intercom file');
  204.     CloseLockFile;
  205.   END;
  206.  
  207.   FUNCTION OpenInterCom(TaskNum: Byte; CONST Address: TFidoAddress): Boolean;
  208.   VAR
  209.     i : Byte;
  210.     InterComRec : TInterCom;
  211.   BEGIN
  212.     New(InterComFile, Open(StartPath+PoPInterComFileName, SizeOf(InterComRec), True));
  213.     IF InterComFile<>NIL THEN
  214.     BEGIN
  215.       IF TaskNum=0 THEN TaskNum:=1;
  216.       IF InterComFile^.FileSize<TaskNum+1 THEN
  217.       BEGIN
  218.         FillChar(InterComRec,Sizeof(InterComRec),0);
  219.         InterComRec.Status:=ICUnused;
  220.         FOR i:=InterComFile^.FileSize TO TaskNum DO
  221.           InterComFile^.PutRec(InterComRec,i);
  222.         InterComFile^.Close;
  223.         InterComFile^.Open(StartPath+PoPInterComFileName, SizeOf(InterComRec), True);
  224.       END;
  225.       InterComFile^.GetRec(InterComRec,TaskNum,NoKeep,Wait);
  226.       ICTaskNum:=TaskNum;
  227.       WITH InterComRec DO
  228.       BEGIN
  229.         Status:=ICIdle;
  230.         MyAddress:=Address;
  231.         InterComFile^.PutRec(InterComRec,TaskNum);
  232.       END ;
  233.       OpenInterCom:=True;
  234.     END ELSE
  235.       OpenInterCom:=False;
  236.   END;
  237.  
  238.   PROCEDURE CloseInterCom;
  239.   BEGIN
  240.     IF InterComFile<>NIL THEN InterComFile^.Close;
  241.     InterComFile:=NIL;
  242.   END;
  243.  
  244.   FUNCTION ICStatusStr(CONST ICR: TInterCom): String;
  245.   BEGIN
  246.     WITH ICR DO
  247.     BEGIN
  248.       CASE Status OF
  249.         ICUnused     : ICStatusStr:='Unused';
  250.         ICIdle       : ICStatusStr:='Idle';
  251.         ICPolling    : ICStatusStr:='Polling node '+Address2Str(PollAddress);
  252.         ICFileFwd    : ICStatusStr:='Forwarding files';
  253.         ICConnect    : ICStatusStr:='Connected to '+Address2Str(PollAddress);
  254.         ICNLComp     : ICStatusStr:='Compiling nodelist';
  255.         ICUnpackMail : ICStatusStr:='Unpacking mail';
  256.  
  257.         ICOutMan     : ICStatusStr:='Using Outbound-manager';
  258.         ICNLMan      : ICStatusStr:='Using Nodelist-manager';
  259.         ICAreaMan    : ICStatusStr:='Using Areamanager';
  260.         ICTextEdit   : ICStatusStr:='Editing a textfile';
  261.         ICMsgEdit    : ICStatusStr:='Reading messages';
  262.         ICDumbTerm   : ICStatusStr:='Using DumbTerminal';
  263.         ICDosShell   : ICStatusStr:='In a DOS-Shell';
  264.         ICConfig     : ICStatusStr:='Configuring the system';
  265.         ICSemExit    : ICStatusStr:='Semafore exit with errorlevel '+Long2Str(PollAddress.Zone);
  266.         ICUserInBBS  : ICStatusStr:='User On-Line';
  267.         ICScanNetMail: ICStatusStr:='Scanning Netmail';
  268.         ICTick       : ICStatusStr:='Processing Tick files';
  269.         ELSE ICStatusStr:='Unknown status?';
  270.       END;
  271.     END;
  272.   END;
  273.  
  274.   PROCEDURE SetToDoFlags(Flag:WORD);
  275.   VAR
  276.     i:BYTE;
  277.     IC:TInterCom;
  278.   BEGIN
  279.     OpenLockFile;
  280.     REPEAT
  281.       GiveUpTime;
  282.     UNTIL NetGrabFile(NetICFile);
  283.     FOR i:=0 TO GetMaxLines DO
  284.       IF i<>ICTaskNum THEN
  285.       BEGIN
  286.         GetInterCom(i,IC);
  287.         IC.ToDoFlags:=IC.ToDoFlags OR Flag;
  288.         InterComFile^.PutRec(IC, i);
  289.       END;
  290.     NetReleaseFile(NetICFile);
  291.     CloseLockFile;
  292.   END;
  293.  
  294. END.
  295.